SUBROUTINE BCAST_3DARR_PROFILE &
& (ix0,ix1,iy0,iy1,is0,is1, &
&  nxi,nxe,nyi,nye,nsi,nse, &
&  ixm,iym, &
&  comm3d, commsize, myrank, &
&  array_3d, array_1d)

! BCAST_3DARR_PROFILE broadcasts the profile (one-dimensional array) 
! in the point (ixm,iym) from the process which domain contains this profile 
! to all other processes. Two-dimensional XY-decomposition of the model domain 
! is assumed. The arguments nsi and nse must be the same for all the processes.

! Note, that the blocking MPI-exchanges are implemented in this subroutine,
! hence multiple (regular) invoking it may consume much time.

!use MPI
use MPI_VARIABLES, only : &
& bcast_3darr_profile_indic
use TIMING_MOD, only : &
& proc_time

include 'mpif.h'

!Input variables

integer(4), intent(in) :: ix0,ix1,iy0,iy1,is0,is1 ! The dimensions of the input array 
integer(4), intent(in) :: nxi,nxe,nyi,nye,nsi,nse ! The bounds of the process domain
integer(4), intent(in) :: ixm,iym ! The coordinates of the profile to be broadcasted
integer(4), intent(in) :: comm3d, commsize, myrank 

real(8), intent(in) :: array_3d(ix0:ix1,iy0:iy1,is0:is1)

! Output variables

real(8), intent(out) :: array_1d(is0:is1)

! Local variables

integer(4) :: k
integer(4) :: ierr, iroot, irank
integer(4) :: istatus(MPI_STATUS_SIZE)
integer(4), save :: itag = 1

real(8), allocatable :: work(:)
real(8) :: pr_time, pro_time

allocate (work(nsi:nse))

if ((ixm >= nxi .and. ixm <= nxe) .and. &
&   (iym >= nyi .and. iym <= nye)) then
  do k = nsi, nse
    work(k) = array_3d(ixm,iym,k)
  enddo
  iroot = myrank
  do irank = 0, commsize-1
    if (irank /= myrank) then

!      pr_time = MPI_WTIME()
      call cpu_time(pr_time)
  
      call MPI_SEND(iroot, 1, MPI_INTEGER, irank, itag, comm3d, ierr)

!      proc_time(bcast_3darr_profile_indic,2) = proc_time(bcast_3darr_profile_indic,2) + &
!      & MPI_WTIME() - pr_time
      call cpu_time(pro_time)
      proc_time(bcast_3darr_profile_indic,2) = proc_time(bcast_3darr_profile_indic,2) + &
      & pro_time - pr_time

    endif
  enddo
else

!  pr_time = MPI_WTIME()
  call cpu_time(pr_time)

  call MPI_RECV(iroot, 1, MPI_INTEGER, MPI_ANY_SOURCE, itag, comm3d, istatus, ierr)

!  proc_time(bcast_3darr_profile_indic,2) = proc_time(bcast_3darr_profile_indic,2) + &
!  & MPI_WTIME() - pr_time
  call cpu_time(pro_time)
  proc_time(bcast_3darr_profile_indic,2) = proc_time(bcast_3darr_profile_indic,2) + &
  & pro_time - pr_time

endif

!pr_time = MPI_WTIME()
call cpu_time(pr_time)

call MPI_BCAST(work(nsi), nse-nsi+1, MPI_DOUBLE_PRECISION, iroot, comm3d, ierr)

!proc_time(bcast_3darr_profile_indic,2) = proc_time(bcast_3darr_profile_indic,2) + &
!& MPI_WTIME() - pr_time
call cpu_time(pro_time)
proc_time(bcast_3darr_profile_indic,2) = proc_time(bcast_3darr_profile_indic,2) + &
& pro_time - pr_time

do k = nsi, nse
  array_1d(k) = work(k)
enddo

deallocate (work)

END SUBROUTINE BCAST_3DARR_PROFILE

